perm filename GFTODO.PSC[MF,ALS] blob sn#800350 filedate 1985-08-14 generic text, type T, neo UTF8
{3:}{$D-,W+}{$D+}PROGRAM GFTOOC(GFFILE,OCFILE,WDFILE);LABEL{4:}9999;{:4}
CONST{5:}LINELENGTH=79;TERMINALLINE=150;MAXGLYPHNO=127;TOPPIXEL=400;
BOTPIXEL=-150;LEFTPIXEL=-150;RIGHTPIXEL=500;MAXPC=50;{:5}{62:}
CHARSEGFILEP=1536;{:62}TYPE{12:}ASCIICODE=32..126;{:12}{13:}
TEXTFILE=PACKED FILE OF CHAR;{:13}{24:}EIGHTBITS=0..255;
BYTEFILE=PACKED FILE OF EIGHTBITS;{:24}{37:}
MCOORD=LEFTPIXEL..RIGHTPIXEL;NCOORD=BOTPIXEL..TOPPIXEL;PCCOORD=0..MAXPC;
{:37}{39:}PIXEL=0..1;{:39}VAR{10:}
BUFFER:ARRAY[0..TERMINALLINE]OF ASCIICODE;{:10}{14:}
XORD:ARRAY[CHAR]OF ASCIICODE;XCHR:ARRAY[0..255]OF CHAR;{:14}{25:}
GFFILE:BYTEFILE;OCFILE:BYTEFILE;WDFILE:BYTEFILE;{:25}{31:}
CURLOC:INTEGER;OCBYTENO:INTEGER;WDBYTENO:INTEGER;{:31}{38:}M:MCOORD;
N:NCOORD;PAINTSWITCH:PIXEL;
PAINTARRAY:ARRAY[BOTPIXEL..TOPPIXEL,0..MAXPC]OF INTEGER;
PAINTVAL:ARRAY[BOTPIXEL..TOPPIXEL]OF PIXEL;PC:PCCOORD;{:38}{40:}
TOTALCHARS:INTEGER;CHARPTR:ARRAY[0..MAXGLYPHNO]OF INTEGER;
GFPREVPTR:INTEGER;CHARCODE:INTEGER;{:40}{49:}BADCHAR:BOOLEAN;
SKIPFLAG:BOOLEAN;PSAVE:INTEGER;XXXBUFFER:ARRAY[1..20]OF EIGHTBITS;
XXXFONTFA:ARRAY[1..6]OF EIGHTBITS;FACEFLAG:BOOLEAN;FONTFAFLAG:BOOLEAN;
{:49}{66:}DESIGNSIZE:INTEGER;HPPP,VPPP:INTEGER;CHECKSUM:INTEGER;
POSTLOC:INTEGER;MAGNIFICATIO:REAL;
TFMWIDTH:ARRAY[0..MAXGLYPHNO]OF INTEGER;
DX:ARRAY[0..MAXGLYPHNO]OF INTEGER;DY:INTEGER;
MINM,MAXM,MINN,MAXN:INTEGER;
MINMSTATED,MAXMSTATED,MINNSTATED,MAXNSTATED:INTEGER;
MINMBOX,MAXMBOX,MINNBOX,MAXNBOX:INTEGER;DELM:INTEGER;DELN:INTEGER;{:66}
{71:}GLYPHPTR:ARRAY[0..MAXGLYPHNO]OF INTEGER;
GLYPHCOLS:ARRAY[0..MAXGLYPHNO]OF INTEGER;
GLYPHROWS:ARRAY[0..MAXGLYPHNO]OF INTEGER;
MINMARRAY:ARRAY[0..MAXGLYPHNO]OF INTEGER;
MINNARRAY:ARRAY[0..MAXGLYPHNO]OF INTEGER;BC,EC,NC:INTEGER;
OCDIRPTR:INTEGER;OCMAG:INTEGER;SEGSTART:INTEGER;SEGEND:INTEGER;
FONTFACEBYTE:INTEGER;RELPTRBASE:INTEGER;PIXRES:INTEGER;FIXEDM:BOOLEAN;
CFACTOR:REAL;COLSMAX,ROWSMAX:INTEGER;TFMMIN,TFMMAX:INTEGER;{:71}{77:}
A:INTEGER;B,I:INTEGER;C,L,O,P,Q,R:INTEGER;BYCT:INTEGER;{:77}
PROCEDURE INITIALIZE;VAR I:INTEGER;
BEGIN WRITELN(TTY,'This is GFtoDOVER, Version 0.3');{15:}
FOR I:=0 TO 31 DO XCHR[I]:='?';XCHR[32]:=' ';XCHR[33]:='!';
XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';XCHR[37]:='%';XCHR[38]:='&';
XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';XCHR[42]:='*';XCHR[43]:='+';
XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';XCHR[47]:='/';XCHR[48]:='0';
XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';XCHR[52]:='4';XCHR[53]:='5';
XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';XCHR[57]:='9';XCHR[58]:=':';
XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';XCHR[62]:='>';XCHR[63]:='?';
XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';XCHR[67]:='C';XCHR[68]:='D';
XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';XCHR[72]:='H';XCHR[73]:='I';
XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';XCHR[77]:='M';XCHR[78]:='N';
XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';XCHR[82]:='R';XCHR[83]:='S';
XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';XCHR[87]:='W';XCHR[88]:='X';
XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';XCHR[92]:='\';XCHR[93]:=']';
XCHR[94]:='↑';XCHR[95]:='_';XCHR[96]:='`';XCHR[97]:='a';XCHR[98]:='b';
XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';XCHR[102]:='f';
XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';XCHR[106]:='j';
XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';XCHR[110]:='n';
XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';XCHR[114]:='r';
XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';XCHR[118]:='v';
XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';XCHR[122]:='z';
XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';XCHR[126]:='~';
FOR I:=127 TO 255 DO XCHR[I]:='?';{:15}{16:}
FOR I:=0 TO 127 DO XORD[CHR(I)]:=32;
FOR I:=32 TO 126 DO XORD[XCHR[I]]:=I;{:16}{41:}
FOR I:=0 TO MAXGLYPHNO DO CHARPTR[I]:=-1;TOTALCHARS:=0;{:41}{50:}
XXXFONTFA[1]:=102;XXXFONTFA[2]:=111;XXXFONTFA[3]:=110;XXXFONTFA[4]:=116;
XXXFONTFA[5]:=102;XXXFONTFA[6]:=97;FACEFLAG:=FALSE;FONTFAFLAG:=FALSE;
FOR I:=1 TO 20 DO XXXBUFFER[I]:=0;{:50}{72:}
FOR I:=0 TO MAXGLYPHNO DO BEGIN GLYPHCOLS[I]:=0;GLYPHROWS[I]:=0;
GLYPHPTR[I]:=-1;END;BC:=MAXGLYPHNO+1;EC:=-1;TFMMIN:=MAXINT;TFMMAX:=0;
COLSMAX:=0;ROWSMAX:=0;MINMBOX:=MAXINT;MINNBOX:=MAXINT;MAXMBOX:=0;
MAXNBOX:=0;{:72}END;{:3}{7:}PROCEDURE JUMPOUT;BEGIN GOTO 9999;END;{:7}
{9:}PROCEDURE PRINTSCALED(S:INTEGER);VAR DELTA:INTEGER;
BEGIN IF S<0 THEN BEGIN WRITE(TTY,'-');S:=-S;END;
WRITE(TTY,S DIV 65536:1);S:=10*(S MOD 65536)+5;
IF S<>5 THEN BEGIN DELTA:=10;WRITE(TTY,'.');
REPEAT IF DELTA>65536 THEN S:=S+32768-(DELTA DIV 2);
WRITE(TTY,CHR(ORD('0')+(S DIV 65536)));S:=10*(S MOD 65536);
DELTA:=DELTA*10;UNTIL S<=DELTA;END;END;{:9}{11:}
FUNCTION LOWERCASIFY(C:ASCIICODE):ASCIICODE;
BEGIN IF(C>=65)AND(C<=90)THEN LOWERCASIFY:=C+32 ELSE LOWERCASIFY:=C;END;
{:11}{27:}PROCEDURE OPENGFFILE;BEGIN RESET(GFFILE,'','/B:8');CURLOC:=0;
END;{:27}{28:}PROCEDURE OPENOCFILE;BEGIN REWRITE(OCFILE,'','/B:8');
OCBYTENO:=0;END;{:28}{29:}PROCEDURE OPENWDFILE;
BEGIN REWRITE(WDFILE,'','/B:8');WDBYTENO:=0;END;{:29}{30:}
PROCEDURE REOPENWDFILE;BEGIN RESET(WDFILE,'','/B:8');WDBYTENO:=0;END;
{:30}{32:}FUNCTION GETBYTE:INTEGER;VAR B:EIGHTBITS;
BEGIN IF EOF(GFFILE)THEN GETBYTE:=0 ELSE BEGIN READ(GFFILE,B);
CURLOC:=CURLOC+1;GETBYTE:=B;END;END;FUNCTION GETTWOBYTES:INTEGER;
VAR A,B:EIGHTBITS;BEGIN READ(GFFILE,A);READ(GFFILE,B);CURLOC:=CURLOC+2;
GETTWOBYTES:=A*256+B;END;FUNCTION GETTHREEBYTE:INTEGER;
VAR A,B,C:EIGHTBITS;BEGIN READ(GFFILE,A);READ(GFFILE,B);READ(GFFILE,C);
CURLOC:=CURLOC+3;GETTHREEBYTE:=(A*256+B)*256+C;END;
FUNCTION SIGNEDQUAD:INTEGER;VAR A,B,C,D:EIGHTBITS;BEGIN READ(GFFILE,A);
READ(GFFILE,B);READ(GFFILE,C);READ(GFFILE,D);CURLOC:=CURLOC+4;
IF A<128 THEN SIGNEDQUAD:=((A*256+B)*256+C)*256+D ELSE SIGNEDQUAD:=(((A
-256)*256+B)*256+C)*256+D;END;{:32}{33:}PROCEDURE OCHALFWORD(W:INTEGER);
BEGIN IF W<0 THEN W:=W+65536;BEGIN WRITE(OCFILE,W DIV 256);
OCBYTENO:=OCBYTENO+1;END;BEGIN WRITE(OCFILE,W MOD 256);
OCBYTENO:=OCBYTENO+1;END;END;PROCEDURE OCWORD(W:INTEGER);
BEGIN IF W>0 THEN BEGIN WRITE(OCFILE,W DIV 16777216);
OCBYTENO:=OCBYTENO+1;END ELSE BEGIN W:=W+1073741824;W:=W+1073741824;
BEGIN WRITE(OCFILE,(W DIV 16777216)+128);OCBYTENO:=OCBYTENO+1;END;END;
BEGIN WRITE(OCFILE,(W DIV 65536)MOD 256);OCBYTENO:=OCBYTENO+1;END;
BEGIN WRITE(OCFILE,(W DIV 256)MOD 256);OCBYTENO:=OCBYTENO+1;END;
BEGIN WRITE(OCFILE,W MOD 256);OCBYTENO:=OCBYTENO+1;END;END;{:33}{34:}
PROCEDURE WDHALFWORD(W:INTEGER);BEGIN IF W<0 THEN W:=W+65536;
BEGIN WRITE(WDFILE,W DIV 256);WDBYTENO:=WDBYTENO+1;END;
BEGIN WRITE(WDFILE,W MOD 256);WDBYTENO:=WDBYTENO+1;END;END;
PROCEDURE WDWORD(W:INTEGER);
BEGIN IF W>0 THEN BEGIN WRITE(WDFILE,W DIV 16777216);
WDBYTENO:=WDBYTENO+1;END ELSE BEGIN W:=W+1073741824;W:=W+1073741824;
BEGIN WRITE(WDFILE,(W DIV 16777216)+128);WDBYTENO:=WDBYTENO+1;END;END;
BEGIN WRITE(WDFILE,(W DIV 65536)MOD 256);WDBYTENO:=WDBYTENO+1;END;
BEGIN WRITE(WDFILE,(W DIV 256)MOD 256);WDBYTENO:=WDBYTENO+1;END;
BEGIN WRITE(WDFILE,W MOD 256);WDBYTENO:=WDBYTENO+1;END;END;{:34}{35:}
FUNCTION GFLENGTH:INTEGER;BEGIN SETPOS(GFFILE,-1);
GFLENGTH:=CURPOS(GFFILE);END;PROCEDURE MOVETOBYTE(N:INTEGER);
BEGIN SETPOS(GFFILE,N);CURLOC:=N;END;{:35}{42:}
FUNCTION FIRSTPAR(O:EIGHTBITS):INTEGER;
BEGIN CASE O OF 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63:FIRSTPAR:=O-0;
64,71,245,246,239:FIRSTPAR:=GETBYTE;65,72,240:FIRSTPAR:=GETTWOBYTES;
66,73,241:FIRSTPAR:=GETTHREEBYTE;242,243:FIRSTPAR:=SIGNEDQUAD;
67,68,69,70,244,247,248,249,250,251,252,253,254,255:FIRSTPAR:=0;
74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,
98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,
116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,
134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,
152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,
170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,
188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,
206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,
224,225,226,227,228,229,230,231,232,233,234,235,236,237,238:FIRSTPAR:=O
-74;END;END;{:42}{43:}FUNCTION DOCHAR:BOOLEAN;LABEL 9998,9999;
VAR O:EIGHTBITS;P,Q:INTEGER;I,J:INTEGER;B:EIGHTBITS;BEGIN DOCHAR:=TRUE;
WHILE TRUE DO{44:}BEGIN A:=CURLOC;O:=GETBYTE;P:=FIRSTPAR(O);
IF EOF(GFFILE)THEN BEGIN WRITE(TTY,' ','Bad GF file: ',
'the file ended prematurely','!');JUMPOUT;END;{46:}IF O<=67 THEN{52:}
BEGIN REPEAT{53:}IF SKIPFLAG THEN BEGIN IF P<PSAVE THEN PSAVE:=P;
SKIPFLAG:=FALSE;END;PAINTARRAY[N,PC]:=P;PC:=PC+1;PAINTARRAY[N,PC]:=0;
{:53};A:=CURLOC;O:=GETBYTE;P:=FIRSTPAR(O);
IF EOF(GFFILE)THEN BEGIN WRITE(TTY,' ','Bad GF file: ',
'the file ended prematurely','!');JUMPOUT;END;UNTIL O>67;END{:52};
CASE O OF 70,71,72,73:{55:}BEGIN PC:=0;WHILE P>=0 DO BEGIN N:=N-1;
PAINTVAL[N]:=0;PAINTARRAY[N,PC]:=0;PAINTARRAY[N,1]:=0;P:=P-1;END;
SKIPFLAG:=TRUE;END{:55};
74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,
98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,
116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,
134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,
152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,
170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,
188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,
206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,
224,225,226,227,228,229,230,231,232,233,234,235,236,237,238:{54:}
BEGIN N:=N-1;PC:=0;PAINTVAL[N]:=0;PAINTARRAY[N,PC]:=P;PC:=PC+1;
PAINTARRAY[N,PC]:=0;IF P<PSAVE THEN PSAVE:=P;SKIPFLAG:=FALSE;END{:54};
{47:}244:;247:BEGIN BEGIN WRITE(TTY,A:1,': ','! ',
'preamble command within a character!');WRITELN(TTY);END;GOTO 9998;END;
248,249:BEGIN BEGIN WRITE(TTY,A:1,': ','! ',
'postamble command within a character!');WRITELN(TTY);END;GOTO 9998;END;
67,68:BEGIN BEGIN WRITE(TTY,A:1,': ','! ',
'boc or boc1 occurred before eoc!');WRITELN(TTY);END;GOTO 9998;END;
69:BEGIN GOTO 9999;END;{:47}239,240,241,242:{48:}BEGIN FACEFLAG:=FALSE;
IF P>6 THEN FONTFAFLAG:=TRUE ELSE FONTFAFLAG:=FALSE;I:=1;
WHILE(I<=6)AND(FONTFAFLAG=TRUE)DO BEGIN Q:=GETBYTE;
IF(Q<>XXXFONTFA[I])THEN FONTFAFLAG:=FALSE;P:=P-1;I:=I+1;END;
IF FONTFAFLAG=TRUE THEN BEGIN Q:=GETBYTE;P:=P-1;
IF Q=99 THEN FACEFLAG:=TRUE ELSE IF Q=109 THEN BEGIN WHILE(P>0)AND(Q<>32
)DO BEGIN Q:=GETBYTE;P:=P-1;END;XXXBUFFER[1]:=P;I:=2;
WHILE(P>0)AND(I<=20)DO BEGIN XXXBUFFER[I]:=GETBYTE;P:=P-1;I:=I+1;END;
WHILE I<>20 DO BEGIN XXXBUFFER[I]:=0;I:=I+1;END;END;END;
WHILE P>0 DO BEGIN Q:=GETBYTE;P:=P-1;END;END{:48};243:{51:}
BEGIN IF FACEFLAG=TRUE THEN BEGIN FONTFACEBYTE:=ROUND(P/65536);
FACEFLAG:=FALSE;END;END{:51};
OTHERS:BEGIN WRITE(TTY,A:1,': ','! ','undefined command ',O:1,'!');
WRITELN(TTY);END END{:46};END{:44};9998:WRITELN(TTY,'!');DOCHAR:=FALSE;
9999:END;{:43}{60:}PROCEDURE TABULATE;VAR N:INTEGER;BEGIN WRITELN(TTY);
WRITE(TTY,'min_m=',MINM:1);WRITE(TTY,' max_m=',MAXM:1);
WRITE(TTY,' max_n=',MAXN:1);WRITE(TTY,' min_n=',MINN:1);WRITELN(TTY);
N:=MAXN;WHILE N>=MINN DO BEGIN PC:=0;WRITELN(TTY);WRITE(TTY,N:3);
IF PAINTVAL[N]=0 THEN WRITE(TTY,'w':3)ELSE WRITE(TTY,'b':3);
WHILE PAINTARRAY[N,PC]>0 DO BEGIN WRITE(TTY,PAINTARRAY[N,PC]:3);
PC:=PC+1;END;N:=N-1;END;WRITELN(TTY);PC:=0;END;{:60}{64:}
PROCEDURE MOVERASTERS;VAR B:EIGHTBITS;BEGIN REOPENWDFILE;B:=0;
WHILE NOT EOF(WDFILE)DO BEGIN READ(WDFILE,B);BEGIN WRITE(OCFILE,B);
OCBYTENO:=OCBYTENO+1;END;END;CLOSE(OCFILE);CLOSE(WDFILE);OPENWDFILE;END;
{:64}{65:}PROCEDURE READPOSTAMBL;VAR K:INTEGER;P,Q,M,C:INTEGER;
BEGIN POSTLOC:=CURLOC-1;P:=SIGNEDQUAD;DESIGNSIZE:=SIGNEDQUAD;
CHECKSUM:=SIGNEDQUAD;HPPP:=SIGNEDQUAD;VPPP:=SIGNEDQUAD;
MAGNIFICATIO:=HPPP/(65536.0*384.0/72.27);
OCMAG:=ROUND(1000*MAGNIFICATIO);MINM:=SIGNEDQUAD;MAXM:=SIGNEDQUAD;
MINN:=SIGNEDQUAD;MAXN:=SIGNEDQUAD;{68:}REPEAT K:=GETBYTE;
IF(K=245)OR(K=246)THEN BEGIN C:=GETBYTE;IF C<BC THEN BC:=C;
IF C>EC THEN EC:=C;IF K=245 THEN BEGIN DX[C]:=SIGNEDQUAD;DY:=SIGNEDQUAD;
END ELSE BEGIN DX[C]:=GETBYTE*65536;DY:=0;END;TFMWIDTH[C]:=SIGNEDQUAD;
IF TFMWIDTH[C]<TFMMIN THEN TFMMIN:=TFMWIDTH[C];
IF TFMWIDTH[C]>TFMMAX THEN TFMMAX:=TFMWIDTH[C];P:=SIGNEDQUAD;K:=244;END;
UNTIL K<>244;{:68};END;{:65}{69:}PROCEDURE FINDPOSTAMBL;VAR Q,K:INTEGER;
BEGIN POSTLOC:=GFLENGTH-4;
REPEAT IF POSTLOC=0 THEN BEGIN WRITE(TTY,' ','Bad GF file: ','all 223s',
'!');JUMPOUT;END;MOVETOBYTE(POSTLOC);K:=GETBYTE;POSTLOC:=POSTLOC-1;
UNTIL K<>223;
IF K<>131 THEN BEGIN WRITE(TTY,' ','Bad GF file: ','ID byte is ',K:1,'!'
);JUMPOUT;END;MOVETOBYTE(POSTLOC-3);Q:=SIGNEDQUAD;
IF(Q<0)OR(Q>POSTLOC-3)THEN BEGIN WRITE(TTY,' ','Bad GF file: ',
'post pointer ',Q:1,' at byte ',POSTLOC-3:1,'!');JUMPOUT;END;
MOVETOBYTE(Q);K:=GETBYTE;
IF K<>248 THEN BEGIN WRITE(TTY,' ','Bad GF file: ','byte ',Q:1,
' is not post','!');JUMPOUT;END;END;{:69}{76:}BEGIN INITIALIZE;
OPENGFFILE;FINDPOSTAMBL;READPOSTAMBL;{78:}OPENGFFILE;O:=GETBYTE;
IF O<>247 THEN BEGIN WRITE(TTY,' ','Bad GF file: ',
'First byte isn''t start of preamble!','!');JUMPOUT;END;O:=GETBYTE;
IF O<>131 THEN BEGIN WRITE(TTY,A:1,': ','! ',
'identification byte should be ',131:1,' not ',O:1,'!');WRITELN(TTY);
END;O:=GETBYTE;WRITE(TTY,'''');WHILE O>0 DO BEGIN O:=O-1;
WRITE(TTY,XCHR[GETBYTE]);END;WRITELN(TTY,'''');{:78};OPENOCFILE;
OPENWDFILE;{79:}REPEAT GFPREVPTR:=CURLOC;{80:}REPEAT A:=CURLOC;
O:=GETBYTE;P:=FIRSTPAR(O);
IF EOF(GFFILE)THEN BEGIN WRITE(TTY,' ','Bad GF file: ',
'the file ended prematurely','!');JUMPOUT;END;IF O=243 THEN BEGIN{51:}
BEGIN IF FACEFLAG=TRUE THEN BEGIN FONTFACEBYTE:=ROUND(P/65536);
FACEFLAG:=FALSE;END;END{:51};O:=244;
END ELSE IF(O>=239)AND(O<=242)THEN BEGIN{48:}BEGIN FACEFLAG:=FALSE;
IF P>6 THEN FONTFAFLAG:=TRUE ELSE FONTFAFLAG:=FALSE;I:=1;
WHILE(I<=6)AND(FONTFAFLAG=TRUE)DO BEGIN Q:=GETBYTE;
IF(Q<>XXXFONTFA[I])THEN FONTFAFLAG:=FALSE;P:=P-1;I:=I+1;END;
IF FONTFAFLAG=TRUE THEN BEGIN Q:=GETBYTE;P:=P-1;
IF Q=99 THEN FACEFLAG:=TRUE ELSE IF Q=109 THEN BEGIN WHILE(P>0)AND(Q<>32
)DO BEGIN Q:=GETBYTE;P:=P-1;END;XXXBUFFER[1]:=P;I:=2;
WHILE(P>0)AND(I<=20)DO BEGIN XXXBUFFER[I]:=GETBYTE;P:=P-1;I:=I+1;END;
WHILE I<>20 DO BEGIN XXXBUFFER[I]:=0;I:=I+1;END;END;END;
WHILE P>0 DO BEGIN Q:=GETBYTE;P:=P-1;END;END{:48};O:=244;END;
UNTIL O<>244;{:80};
IF O<>248 THEN BEGIN IF(O<67)OR(O>68)THEN BEGIN WRITE(TTY,' ',
'Bad GF file: ','byte ',CURLOC-1:1,' is not boc (',O:1,')','!');JUMPOUT;
END;WRITE(TTY,' [');{81:}A:=CURLOC;TOTALCHARS:=TOTALCHARS+1;
IF O=67 THEN BEGIN CHARCODE:=SIGNEDQUAD;P:=SIGNEDQUAD;
C:=CHARCODE MOD 256;IF C<0 THEN C:=C+256;WRITE(TTY,C:1);
IF CHARCODE<>C THEN WRITE(TTY,' in family ',(CHARCODE-C)DIV 256:1);
MINMSTATED:=SIGNEDQUAD;MAXMSTATED:=SIGNEDQUAD;MINNSTATED:=SIGNEDQUAD;
MAXNSTATED:=SIGNEDQUAD;END ELSE BEGIN CHARCODE:=GETBYTE;P:=-1;
C:=CHARCODE;WRITE(TTY,C:1);DELM:=GETBYTE;MAXMSTATED:=GETBYTE;
DELN:=GETBYTE;MAXNSTATED:=GETBYTE;MINMSTATED:=MAXMSTATED-DELM;
MINNSTATED:=MAXNSTATED-DELN;END;M:=MINMSTATED;N:=MAXNSTATED;
PSAVE:=MAXMSTATED;SKIPFLAG:=TRUE;
IF CHARPTR[C]<>P THEN BEGIN WRITE(TTY,A:1,': ','! ',
'previous character pointer should be ',CHARPTR[C]:1,', not ',P:1,'!');
WRITELN(TTY);END;CHARPTR[C]:=GFPREVPTR;PC:=0;PAINTVAL[N]:=0;
PAINTARRAY[N,PC]:=0;PAINTARRAY[N,PC+1]:=0;{:81};
IF NOT DOCHAR THEN BEGIN WRITE(TTY,' ','Bad GF file: ',
'char ended unexpectedly','!');JUMPOUT;END;{82:}{:82};{57:}
BEGIN MINN:=MINNSTATED;MAXN:=MAXNSTATED;MINM:=MINMSTATED+PSAVE;N:=MAXN;
PC:=0;
WHILE N>=MINN DO BEGIN IF(PAINTARRAY[N,PC]<>0)OR(PAINTARRAY[N,PC+1]<>0)
THEN BEGIN PAINTARRAY[N,PC]:=PAINTARRAY[N,PC]-PSAVE;
IF PAINTARRAY[N,PC]=0 THEN BEGIN PAINTVAL[N]:=1;
PAINTARRAY[N,PC]:=PAINTARRAY[N,1];PC:=1;
WHILE PAINTARRAY[N,PC]<>0 DO BEGIN PAINTARRAY[N,PC]:=PAINTARRAY[N,PC+1];
PC:=PC+1;END;PC:=0;END;END;N:=N-1;END;
IF MINM<MINMBOX THEN MINMBOX:=MINM;END{:57};{58:}MAXM:=MINM;N:=MAXN;
WHILE N>=MINN DO BEGIN C:=MINM-1;PC:=0;
WHILE PAINTARRAY[N,PC]>0 DO BEGIN C:=C+PAINTARRAY[N,PC];PC:=PC+1;END;
IF C>MAXM THEN MAXM:=C;N:=N-1;END;IF MAXM>MAXMBOX THEN MAXMBOX:=MAXM;
{:58};{59:}N:=MAXN;PC:=0;
WHILE(PAINTARRAY[N,PC]=0)AND(N>MINN)DO BEGIN N:=N-1;MAXN:=N;END;
IF MAXN>MAXNBOX THEN MAXNBOX:=MAXN;N:=MINN;
WHILE(PAINTARRAY[N,PC]=0)AND(N<MAXN)DO BEGIN N:=N+1;MINN:=N;END;
IF MINN<MINNBOX THEN MINNBOX:=MINN;{:59};{61:}
GLYPHCOLS[CHARCODE]:=MAXM+1-MINM;GLYPHROWS[CHARCODE]:=MAXN+1-MINN;
MINMARRAY[CHARCODE]:=MINM;MINNARRAY[CHARCODE]:=MINN;{:61};{63:}
IF GLYPHPTR[CHARCODE]<>-1 THEN BEGIN WRITE(TTY,A:1,': ','! ',
'Duplicate glyph');WRITELN(TTY);END;
GLYPHPTR[CHARCODE]:=WDBYTENO DIV 2+CHARSEGFILEP;
WDHALFWORD(-MAXN+MINN-1);WDHALFWORD(MAXM-MINM);B:=0;I:=1;N:=MINN;
M:=MINM;PC:=0;
WHILE M<=MAXM DO BEGIN WHILE(I<=8)AND(N<=MAXN)DO BEGIN B:=B+B+PAINTVAL[N
];
IF PAINTARRAY[N,PC]>1 THEN PAINTARRAY[N,PC]:=PAINTARRAY[N,PC]-1 ELSE IF
PAINTARRAY[N,PC]=1 THEN BEGIN IF PAINTVAL[N]=1 THEN PAINTVAL[N]:=0 ELSE
PAINTVAL[N]:=1;
WHILE PAINTARRAY[N,PC]>0 DO BEGIN PAINTARRAY[N,PC]:=PAINTARRAY[N,PC+1];
PC:=PC+1;END;PC:=0;END;I:=I+1;N:=N+1;END;
IF I>8 THEN BEGIN BEGIN WRITE(WDFILE,B);WDBYTENO:=WDBYTENO+1;END;B:=0;
I:=1;END;IF N>MAXN THEN BEGIN M:=M+1;N:=MINN;END;END;
IF(I<=8)AND(I>1)THEN BEGIN WHILE I<=8 DO BEGIN B:=B+B;I:=I+1;END;
BEGIN WRITE(WDFILE,B);WDBYTENO:=WDBYTENO+1;END;END;
WHILE(WDBYTENO MOD 4)<>0 DO BEGIN WRITE(WDFILE,0);WDBYTENO:=WDBYTENO+1;
END;{:63};WRITE(TTY,']');END;UNTIL O=248;{:79};{73:}BC:=0;
WHILE(GLYPHPTR[BC]=-1)AND(BC<MAXGLYPHNO)DO BC:=BC+1;EC:=MAXGLYPHNO;
WHILE(GLYPHPTR[EC]=-1)AND(EC>0)DO EC:=EC-1;
IF BC>EC THEN BEGIN WRITE(TTY,A:1,': ','! ',
'No characters in this font!');WRITELN(TTY);END;NC:=EC+1-BC;
WRITELN(TTY);WRITE(TTY,'bc = ',BC:1);WRITE(TTY,' ec = ',EC:1);
SEGSTART:=CHARSEGFILEP-(10)*NC;SEGEND:=CHARSEGFILEP+(WDBYTENO DIV 2);
IF(FONTFACEBYTE<0)OR(FONTFACEBYTE>256)THEN BEGIN WRITE(TTY,A:1,': ','! '
,'Fontface out of bnds');WRITELN(TTY);END;OCHALFWORD(4108);
OCHALFWORD(0);BYCT:=1;
WHILE BYCT<=20 DO BEGIN BEGIN WRITE(OCFILE,XXXBUFFER[BYCT]);
OCBYTENO:=OCBYTENO+1;END;BYCT:=BYCT+1;END;OCHALFWORD(20491);
BEGIN WRITE(OCFILE,0);OCBYTENO:=OCBYTENO+1;END;
BEGIN WRITE(OCFILE,FONTFACEBYTE);OCBYTENO:=OCBYTENO+1;END;
BEGIN WRITE(OCFILE,BC);OCBYTENO:=OCBYTENO+1;END;BEGIN WRITE(OCFILE,EC);
OCBYTENO:=OCBYTENO+1;END;
OCHALFWORD(ROUND(DESIGNSIZE*MAGNIFICATIO*2540/(72.27*16*65536)));
OCHALFWORD(0);OCWORD(SEGSTART);
OCWORD(CHARSEGFILEP-SEGSTART+(WDBYTENO DIV 2));PIXRES:=3840;
OCHALFWORD(PIXRES);OCHALFWORD(PIXRES);OCHALFWORD(1);
IF OCBYTENO<>48 THEN BEGIN WRITE(TTY,A:1,': ','! ',
'This cannot happen: header error');WRITELN(TTY);END;
WHILE OCBYTENO<2*SEGSTART DO OCHALFWORD(0);{:73};{74:}C:=BC;
WHILE C<=EC DO BEGIN IF GLYPHPTR[C]<>-1 THEN BEGIN OCWORD(DX[C]);
OCWORD(0);OCHALFWORD(MINMARRAY[C]);OCHALFWORD(MINNARRAY[C]);
OCHALFWORD(GLYPHCOLS[C]);OCHALFWORD(GLYPHROWS[C]);END ELSE BEGIN I:=1;
WHILE I<=7 DO BEGIN OCHALFWORD(0);I:=I+1;END;OCHALFWORD(-1);END;C:=C+1;
END;RELPTRBASE:=CHARSEGFILEP-2*NC;
IF OCBYTENO<>2*RELPTRBASE THEN BEGIN WRITE(TTY,A:1,': ','! ',
'rel ptr base error');WRITELN(TTY);END;C:=BC;
WHILE C<=EC DO BEGIN IF GLYPHPTR[C]<>-1 THEN OCWORD(GLYPHPTR[C]-
RELPTRBASE)ELSE OCWORD(-1);C:=C+1;END;CLOSE(WDFILE);{:74};MOVERASTERS;
WRITE(TTY,'  File has ',TOTALCHARS:1,' character');
IF TOTALCHARS<>1 THEN WRITE(TTY,'s');{75:}WDHALFWORD(4108);
WDHALFWORD(0);BYCT:=1;
WHILE BYCT<21 DO BEGIN BEGIN WRITE(WDFILE,XXXBUFFER[BYCT]);
WDBYTENO:=WDBYTENO+1;END;BYCT:=BYCT+1;END;WDHALFWORD(16393);
BEGIN WRITE(WDFILE,0);WDBYTENO:=WDBYTENO+1;END;
BEGIN WRITE(WDFILE,FONTFACEBYTE);WDBYTENO:=WDBYTENO+1;END;
BEGIN WRITE(WDFILE,BC);WDBYTENO:=WDBYTENO+1;END;BEGIN WRITE(WDFILE,EC);
WDBYTENO:=WDBYTENO+1;END;WDHALFWORD(0);WDHALFWORD(0);WDWORD(22);
IF FIXEDM THEN WDWORD(7)ELSE WDWORD(NC+6);WDHALFWORD(1);
IF WDBYTENO<>44 THEN BEGIN WRITE(TTY,A:1,': ','! ',
'This cannot happen: header error');WRITELN(TTY);END;
CFACTOR:=1000*(1048576/(5.313408*DESIGNSIZE));
WDHALFWORD(ROUND(MINMBOX*CFACTOR));WDHALFWORD(ROUND(MINNBOX*CFACTOR));
COLSMAX:=MAXMBOX+1-MINMBOX;WDHALFWORD(ROUND(COLSMAX*CFACTOR));
ROWSMAX:=MAXNBOX+1-MINNBOX;WDHALFWORD(ROUND(ROWSMAX*CFACTOR));
IF TFMMIN=TFMMAX THEN FIXEDM:=TRUE ELSE FIXEDM:=FALSE;
IF FIXEDM THEN BEGIN WRITE(WDFILE,192);WDBYTENO:=WDBYTENO+1;
END ELSE BEGIN WRITE(WDFILE,64);WDBYTENO:=WDBYTENO+1;END;
BEGIN WRITE(WDFILE,0);WDBYTENO:=WDBYTENO+1;END;
IF FIXEDM THEN WDHALFWORD(TFMMAX)ELSE BEGIN C:=BC;
WHILE C<=EC DO BEGIN IF GLYPHPTR[C]=-1 THEN BEGIN BEGIN WRITE(WDFILE,128
);WDBYTENO:=WDBYTENO+1;END;BEGIN WRITE(WDFILE,0);WDBYTENO:=WDBYTENO+1;
END;END ELSE WDHALFWORD(ROUND(TFMWIDTH[C]*1000/1048576));C:=C+1;END;END;
WDHALFWORD(0);IF WDBYTENO<>56+2*NC THEN BEGIN WRITELN(TTY);
WRITE(TTY,WDBYTENO);WRITE(TTY,' instead of ',56+2*NC:1);END;
IF(WDBYTENO MOD 4)<>0 THEN WDHALFWORD(0);{:75};9999:END.{:76}